home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Aminet 5
/
Aminet 5 - March 1995.iso
/
Aminet
/
util
/
rexx
/
ARexxG2_0A.lha
/
ARexxGuide
/
ARx_RarpInfoWin.rexx
< prev
next >
Wrap
OS/2 REXX Batch file
|
1994-04-02
|
11KB
|
316 lines
/* $VER: ARx_RArpInfoWin.rexx v 2.0 **
** Opens a rexxarplib window that displays information about the **
** ARexx statement on the current line of an editor. Called as **
** external function by ARx_Help.#?. **
** Arguments: **
** HLine := The full line on which cursor is located **
** LkUp := The word on which cursor is located **
** CurPos := Cursor x position within HLine **
** Kwd := The first word in HLine **
** PoC := Port to which button commands will be sent **
** ExecStr := The string that's sent by rexxarplib button press **
** WInfo := Position and screen name of editor window */
parse arg HLine, LkUp, CurPos, Kwd, PoC,ExecStr, WInfo
/* They should still be on list, but just in case... */
call addlib('rexxsupport.library', 0, -30, 0)
call addlib('rexxarplib.library', 0, -30, 0)
call addlib('amigaguide.library', -2, -30, 0)
if word(ExecStr, 1) = 'QUOTE' then do
QuoteCmd = 1
ExecStr = subword(ExecStr, 2)
end
else
QuoteCmd = 0
/* figure out what type of clause the current line is */
select
/* Is it an assignment? Check later on for valid var */
when word(HLine, 2) = '=' then
CType = 2
/* Is it a comment? */
when pos('/*', HLine) < CurPos & pos('/*', HLine) ~= 0 then
if pos('*/', HLine) > CurPos | pos('*/', HLine) = 0 then
CType = 4
/* Is it an instruction? */
when getxref(word(HLine,1)) ~= 10 then do
Xref = getxref(word(HLine,1))
if word(Xref,3) = 2 then
CType = 1
end
/* Is it a label? */
when right(word(HLine,1), 1) = ':' then
CType = 3
/* Is it null? */
when HLine = '' then
CType = 5
/* Then it must be a command or assignment without spaces. */
otherwise
CType = 0
/* Is it an assignment instead of a command? */
EqPos = pos('=', HLine)
if EqPos > 0 then do
/* Add spaces for later checks */
if symbol(strip(left(HLine, EqPos-1))) ~= 'BAD' then do
HLine=insert(' ', HLine, EqPos - 1)
HLine = insert(' ', HLine, EqPos + 2)
CType = 2
if CurPos > EqPos then CurPos = CurPos + 2
end
end
end
if CType = 2 then
if ~IsVar(word(HLine, 1)) then
CType = 0
/* Prepare window gadgets to explain the clause. */
CName.0 = 'Command'
CName.1 = 'Instruction'
CName.2 = 'Assignment'
CName.3 = 'Label'
CName.4 = 'Comment'
CName.5 = 'Null'
Gad. = ''
Gad.1.6Txt = 'Current clause is'
Gad.1.6Btn = CName.CType
Gad.1.6Cmd = ExecStr CName.CType
Gadgets = 1
select
when CType = 1 then do
Gad.2.6Txt = 'Current keyword is'
Gad.2.6Btn = Kwd
Gad.2.6Cmd = ExecStr Kwd
Gadgets = 2
end
when CType = 3 then do
Gad.2.6Txt = 'Name of subroutine:' word(HLine,1)'.'
Gadgets = 2
end
/* happens when cursor is at the end of a comment */
when ~datatype(CType, 'N') then
Gadgets = 0
otherwise
end
/* Figure out what the current word is doing */
/* Use variables to make the bit settings more obvious */
FuncName = 0; Arg = 1; Str = 2; Var = 3; Num=4; Hex=5; Bin=6; Cnst=7; Cmpd = 8
if CType <= 3 & LkUp > '' then do
/* Split the string so we can compare both sides */
parse var HLine LStr =CurPos RStr
/* Get only the portion of the string which contains LkUp */
WdRange = substr(HLine, max(1, CurPos - length(LkUp)), length(LkUp) *2)
/* Use Bit functions to keep multiple matches */
WType = null()||null() /* Using more than 8 bytes */
/* Is it a string in single quotes ? */
if IsVar(LkUp) then do
WType = bitset(WType, Var)
if Kwd = 'CALL' then
if abbrev(word(HLine, 2), LkUp) then
WType = bitset(WType, FuncName)
else
WType = bitset(Wtype, Arg)
end
if verify(HLine, '"''', M) > 0 then do
if CountChar(LStr, "'")//2 then do
WType = bitset(WType, Str)
/* Is it a quoted function name? */
if pos(LkUp"'(", WdRange) & bittst(WType, Var) then
WType = bitset(WType, FuncName)
else if datatype(LkUp, X) then
if pos(upper(LkUp)"'X", upper(HLine)) > 0 then
WType = bitset(WType, Hex)
else if datatype(LkUp, B) then
if pos(upper(LkUp)"'B", upper(WdRange)) > 0 then
WType = bitset(WType, Bin)
end
/* Is it a string in double quotes? */
else if CountChar(LStr, '"')//2 then do
WType = bitset(WType, Str)
if pos(LkUp'"(', WdRange) & bittst(WType, Var) then
WType = bitset(WType, FuncName)
else if datatype(LkUp, X) then
if pos(upper(LkUp)'"X', upper(HLine)) then
WType = bitset(WType, Hex)
else if datatype(LkUp, B) then
if pos(upper(LkUp)'"B', upper(WdRange)) > 0 then
WType = bitset(WType, Bin)
end
/* If it's a string, it isn't a variable */
if bittst(WType, Str) then
WType = bitclr(WType, Var)
end
/* Is current word enclosed in parens? */
if verify(HLine, "()", M) > 0 then do
if CountChar(LStr, "(") - CountChar(LStr, ")") > 0 then
WType = bitset(WType, Arg)
if pos(LkUp'(', WdRange) > 0 & bittst(WType, Var) then
WType = bitset(WType, FuncName)
end
/* is it a number or constant? */
if datatype(LkUp, N) then do
/* Make sure it isn't already a hex or bin string */
if ~bittst(WType, Hex) & ~bittst(WType, Bin) then
WType = bitset(WType, Num)
end
/* compare String/Var. If it isn't one of those it's a constant */
else if ~bittst(WType, Var) then do
if ~bittst(WType, Str) then
WType = bitset(WType, Cnst)
end
else if pos('.', LkUp) > 0 then
WType = bitset(WType, Cmpd)
/* it could have been assigned FuncName in either check above **
** In either case, a Function name isn't a variable */
if bittst(WType, FuncName) then
WType = bitclr(WType, Var)
if CType = 3 then
if abbrev(Kwd, upper(LkUp)) then
WType = null()
/* Now take out the string def from hex/bin numbers */
if verify(bitcomp(WType, bitand(d2c(hex), d2c(bin))), Hex Bin) = 0 then
WType = bitclr(WType, Str)
/** Prepare gadgets to explain current word **/
if WType ~= null() then do
interpret 'Gad.'Gadgets+1'.6Txt = ''"''Lkup''" is'''
if bittst(WType, FuncName) then do
Gadgets = Gadgets + 1
Gad.Gadgets.6Btn = 'Function name'
Gad.Gadgets.6Cmd = ExecStr 'FUNCTION'
end
if bittst(WType, Arg) then do
Gadgets = Gadgets + 1
Gad.Gadgets.6Btn = 'Function argument'
Gad.Gadgets.6Cmd = ExecStr 'FUNCARG'
end
if bittst(WType, Str) then do
Gadgets = Gadgets + 1
Gad.Gadgets.6Btn = 'String'
Gad.Gadgets.6Cmd = ExecStr 'STRINGEXPR'
end
if bittst(WType, Hex) then do
Gadgets = Gadgets + 1
Gad.Gadgets.6Btn = 'Hex string'
Gad.Gadgets.6Cmd = ExecStr 'HEXSTRING'
end
if bittst(WType, Bin) then do
Gadgets = Gadgets + 1
Gad.Gadgets.6Btn = 'Binary string'
Gad.Gadgets.6Cmd = ExecStr 'HEXSTRING'
end
if bittst(WType, Var) then do
Gadgets = Gadgets + 1
Gad.Gadgets.6Btn = 'Variable'
Gad.Gadgets.6Cmd = ExecStr 'VARIABLE'
end
if bittst(WType, Cmpd) then do
Gadgets = Gadgets + 1
Gad.Gadgets.6Btn= 'Compound variable'
Gad.Gadgets.6Cmd = ExecStr 'COMPVAR'
end
if bittst(WType, Num) then do
Gadgets = Gadgets + 1
Gad.Gadgets.6Btn = 'Number'
Gad.Gadgets.6Cmd = ExecStr 'NUMBER'
end
if bittst(WType, Cnst) then do
Gadgets = Gadgets + 1
Gad.Gadgets.6Btn = 'Constant symbol'
Gad.Gadgets.6Cmd = ExecStr 'CONSTANT'
end
end
end
/* Open the rexxarplib requester window */
CPort = 'ARX_ARP'
if ~InfoWin(CPort, Gadgets+2, 'Lookup:' LkUp, PoC, word(WInfo, 1), word(WInfo, 2), word(Winfo, 3)) then return 10
if PoC = 'ARX_HELP' then
CloseCmd = 'address' CPort '"QUIT";Status = CLOSE'
else if abbrev(PoC, 'TURBO') then
CloseCmd = 'ExecARexxString address' CPort '"QUIT"'
else
CloseCmd = 'address' CPort '"QUIT"'
/* Draw the gadgets into the window */
x = 10; y = 32
do i = 1 to Gadgets
call move(CPort, x, y)
if Gad.i.6Btn = '' then
Txt = center(Gad.i.6Txt,47)
else
Txt = right(Gad.i.6Txt, 21)
call Text(CPort, Txt)
if Gad.i.6Btn > '' then do
if QuoteCmd then
Gad.i.6Cmd = '"'Gad.i.6Cmd'"'
call AddGadget(CPort, 192, y - 9, i, ' 'left(Gad.i.6Btn, 26),Gad.i.6Cmd)
end
y = y + 15
end
/* Can't open onto the index contents because that is in main */
if QuoteCmd then
IdxCmd = '"'ExecStr 'ARx_NdxCont"'
else
IdxCmd = ExecStr 'ARx_NdxCont'
call AddGadget(CPort, 10, y-4, 14, ' View ARexxGuide index ',IdxCmd)
call AddGadget(CPort, 344, y-4, 15, ' Cancel ', CloseCmd)
/* Since some editors can't receive commands to be sent on to AmigaGuide **
** this port can be used to receive command from the button window. It's **
** opened if the address established by the SETADDRESS function in the **
** editor macro is set to 'ARX_HELP' */
if PoC = 'ARX_HELP' then do
PortAddr = openport(Poc)
/* Loop until a Cmd changes the value of [Status] */
do until Status = 'CLOSE'
call waitpkt(PoC)
Packet = getpkt(PoC)
/* Make sure we have a real message in [Packet] */
if Packet ~= null() then do
Cmd = strip(getarg(Packet),,'"')
interpret Cmd
call reply(Packet, 0)
status = 'CLOSE' /* It was a good command, so get out */
end
end
call closeport PortAddr
end
return 0
InfoWin: procedure
parse arg CPort, Rows, WinTitle, PoC, x, y, PubScr
/** shut down previous requester if it's still around **/
if show(P, CPort) then do; address value CPort; quit; address; end
/* change notifyport (PoC) to a port read by this script */
address ARexx "'call CreateHost("CPort"," PoC", "PubScr")'"
/** Open the window **/
idcmp = 'CLOSEWINDOW+GADGETUP'
flags = 'WINDOWCLOSE+WINDOWDRAG+WINDOWDEPTH+ACTIVATE'
address command 'waitforport' CPort
Height = 16+15*Rows
if rc = 0 then do
call OpenWindow(CPort, x, y, 422, Height, idcmp,flags, WinTitle)
call SetAPen(CPort, 2)
call SetNotify(CPort, CLOSEWINDOW, CPort)
return 1
end
else
return 0
CountChar:
call trace b
return length(arg(1)) - length(compress(arg(1), arg(2)))
IsVar:
call trace b
return symbol(arg(1)) ~== 'BAD' & (datatype(left(arg(1),1), m),
| verify(left(arg(1),1), '!$_@#', M))